Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/sorts2/sorts.frm

Visual Basic Form | 1995-05-08 | 21.8 KB | 789 lines

VERSION 2.00
Begin Form Sorts
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "A Program of Sorts"
   ClientHeight    =   5250
   ClientLeft      =   1095
   ClientTop       =   1425
   ClientWidth     =   6690
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   ForeColor       =   &H00FFFFFF&
   Height          =   5655
   Icon            =   SORTS.FRX:0000
   Left            =   1035
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5250
   ScaleWidth      =   6690
   Top             =   1080
   Width           =   6810
   Begin CommandButton EXIT_PGM
      Caption         =   "EXIT"
      Enabled         =   0   'False
      Height          =   855
      Left            =   5580
      TabIndex        =   7
      Top             =   240
      Width           =   855
   End
   Begin CommandButton START
      Caption         =   "START"
      Height          =   855
      Left            =   4500
      TabIndex        =   6
      Top             =   240
      Width           =   855
   End
   Begin PictureBox SortPlot
      BackColor       =   &H00FFFFFF&
      DrawWidth       =   3
      ForeColor       =   &H00000000&
      Height          =   3996
      Left            =   240
      ScaleHeight     =   3960
      ScaleWidth      =   3960
      TabIndex        =   0
      Top             =   240
      Width           =   3996
   End
   Begin Label Label5
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "EXIT leaves program, writes result file."
      Height          =   435
      Left            =   4440
      TabIndex        =   11
      Top             =   1200
      Width           =   2055
   End
   Begin Label Label4
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Results text file will be placed in C:\SORT_LST.TXT"
      ForeColor       =   &H00FF0000&
      Height          =   615
      Left            =   4440
      TabIndex        =   10
      Top             =   1920
      Width           =   2055
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Algorithm Run Time"
      Height          =   255
      Left            =   4440
      TabIndex        =   9
      Top             =   2700
      Width           =   2055
   End
   Begin Label text1
      Alignment       =   2  'Center
      BackColor       =   &H0000FFFF&
      Caption         =   "Algorithm   Now Running   Shown on Title Bar"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1275
      Left            =   4560
      TabIndex        =   8
      Top             =   3780
      Visible         =   0   'False
      Width           =   1815
   End
   Begin Label Clock
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "00:00.00"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   18
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   435
      Left            =   4440
      TabIndex        =   5
      Top             =   3000
      Width           =   2055
   End
   Begin Label Swaps
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "XXX"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   13.5
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   315
      Left            =   2700
      TabIndex        =   4
      Top             =   4680
      Width           =   975
   End
   Begin Label Iterations
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "XXX"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   13.5
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   315
      Left            =   780
      TabIndex        =   3
      Top             =   4680
      Width           =   975
   End
   Begin Label Label3
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Swaps"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   2700
      TabIndex        =   2
      Top             =   4320
      Width           =   975
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Iterations"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   780
      TabIndex        =   1
      Top             =   4320
      Width           =   975
   End
Dim unit(100) As Integer
Dim StartTime As Double
Dim oldx1 As Integer, oldy1 As Integer, oldx2 As Integer, oldy2 As Integer
Dim newx1 As Integer, newy1 As Integer, newx2 As Integer, newy2 As Integer
Dim Done As Integer, DisplayOn As Integer
Dim comp As Integer, swic As Integer
Dim p(100) As Integer, w(100) As Integer
Dim results(3, 8) As String
Dim base_data(100) As Integer
Dim first_pass As Integer
Sub bsort ()
    StartTime = Now
    Dim j As Integer, k As Integer, l As Integer, t As Integer
    For l = 1 To 100
        j = l
        For k = j + 1 To 100
            comp = comp + 1
            If unit(k) <= unit(j) Then
                j = k
                q% = DoEvents()
            End If
        Next k
        If l <> j Then
            swic = swic + 1
            t = unit(j)
            oldx1 = unit(j)
            oldy1 = j
            unit(j) = unit(l)
            oldx2 = unit(l)
            oldy2 = l
            newx1 = unit(j)
            newy1 = j
            unit(l) = t
            newx2 = unit(l)
            newy2 = l
            ShowTime
            ShowIter
            OverPlot
            NewPlot
                q% = DoEvents()
        End If
    Next l
    ShowTime
    ShowIter
End Sub
Sub dfsort ()
    Dim cl As Integer, cr As Integer, k As Integer
    Dim min As Integer, max As Integer, umin As Integer, umax As Integer, t As Integer
    StartTime = Now
    For cl = 1 To 50
        cr = 101 - cl
        max = unit(cr)
        umax = cr
        min = unit(cl)
        umin = cl
                q% = DoEvents()
        For k = cr To cl Step -1
            comp = comp + 1
                q% = DoEvents()
            If unit(k) < min Then
                min = unit(k)
                umin = k
            End If
        Next k

        If unit(cl) > unit(umin) Then
            swic = swic + 1
            t = unit(cl)
            oldx1 = unit(cl)
            oldy1 = cl
            unit(cl) = unit(umin)
            newx1 = unit(cl)
            newy1 = cl
            oldx2 = unit(umin)
            oldy2 = umin
            unit(umin) = t
            newx2 = unit(umin)
            newy2 = umin
            ShowTime
            ShowIter
            OverPlot
            NewPlot
                q% = DoEvents()
        End If

        For k = cl To cr
            comp = comp + 1
                q% = DoEvents()
            If unit(k) > max Then
                max = unit(k)
                umax = k
            End If
                q% = DoEvents()
        Next k

        If unit(umax) > unit(cr) Then
            swic = swic + 1
            t = unit(cr)
            oldx1 = unit(cr)
            oldy1 = cr
            unit(cr) = unit(umax)
            newx1 = unit(cr)
            newy1 = cr
            oldx2 = unit(umax)
            oldy2 = umax
            unit(umax) = t
            newx2 = unit(umax)
            newy2 = umax
            ShowTime
            ShowIter
            OverPlot
            NewPlot
                q% = DoEvents()
        End If
    Next cl
    ShowTime
    ShowIter
End Sub
Sub EXIT_PGM_Click ()
Unload sorts
End Sub
Sub Form_Load ()
    Screen.MousePointer = 11
    Randomize
    SortPlot.Scale (1, 1)-(100, 100)
    sorts.Refresh
    RackEmUp
    ShowPlots
    DisplayOn = True
    Screen.MousePointer = 0
    first_pass = False
End Sub
Sub Form_Unload (Cancel As Integer)
Open "c:\sort_lst.txt" For Output As #1
Print #1, "Sort"; Chr$(9); "Time"; Chr$(9); "Iterations"; Chr$(9); "Swaps"; Chr$(13); Chr$(10)
For x = 1 To 8
    Print #1, results(0, x); Chr$(9); results(1, x); Chr$(9); results(2, x); Chr$(9); results(3, x); Chr$(13); Chr$(10)
Next x
Close #1
End Sub
Sub gksort ()
    StartTime = Now
    SortStep = 100
    SortTemp = SortStep
    Swap = True
    Do While SortStep > 0 And Swap
        Swap = False
        For RangeEnd = SortStep To 100 Step SortStep
            For RangeStart = RangeEnd - SortStep To RangeEnd - 1 Step SortStep
                If RangeEnd + SortStep > 100 Then RangeEnd = 100
                    For i% = 0 To (RangeEnd - RangeStart) \ 2
                        If unit(i% + RangeStart) > unit(RangeEnd - i%) Then
                            swic = swic + 1
                            Swap = True
                            t = unit(i% + RangeStart)
                            oldx1 = unit(i% + RangeStart)
                            oldy1 = i% + RangeStart
                            unit(i% + RangeStart) = unit(RangeEnd - i%)
                            newx1 = unit(i% + RangeStart)
                            newy1 = i% + RangeStart
                            oldx2 = unit(RangeEnd - i%)
                            oldy2 = RangeEnd - i%
                            unit(RangeEnd - i%) = t
                            newx2 = unit(RangeEnd - i%)
                            newy2 = RangeEnd - i%
                            ShowTime
                            ShowIter
                            OverPlot
                            NewPlot
                        End If
                        comp = comp + 1
                    Next i%
            Next RangeStart
        Next RangeEnd
        If Not Swap Then
            x = 100 \ SortStep
            x = x + 1
            SortStep = 100 \ x
            If SortStep = SortTemp Then
                SortStep = SortStep - 1
            End If
            SortTemp = SortStep
            Swap = True
        End If
    Loop
    ShowTime
    ShowIter
End Sub
Sub HeapSort_Click ()
If Done = True Then resetplot
hsort
End Sub
Sub hsort ()
    StartTime = Now
    For i = 1 To 100
        j = i
        k = 0
        Do While unit(i) <> i And j <= 100
                q% = DoEvents()
            j = j + 1
            comp = comp + 1
            If unit(unit(i)) <> unit(i) Then
                q% = DoEvents()
                swic = swic + 1
                t = unit(unit(i))
                oldx1 = unit(unit(i))
                oldy1 = unit(i)
                unit(unit(i)) = unit(i)
                newx1 = unit(unit(i))
                newy1 = unit(i)
                oldx2 = unit(i)
                oldy2 = i
                unit(i) = t
                newx2 = unit(i)
                newy2 = i
                ShowTime
                ShowIter
                OverPlot
                NewPlot
            End If
                q% = DoEvents()
        Loop
    Next i
    ShowTime
    ShowIter
    selsort
End Sub
Sub isort ()
    Dim i As Integer, j As Integer, v As Integer
    StartTime = Now
    n = 100
    For j = 2 To n
                q% = DoEvents()
        v = unit(j)
        oldx1 = unit(j)
        oldy1 = j
        i = j - 1
        comp = comp + 1
        While v < unit(i)
                q% = DoEvents()
            swic = swic + 1
            unit(i + 1) = unit(i)
            oldx2 = unit(i)
            oldy2 = i
            newx2 = unit(i + 1)
            newy2 = i + 1
            ShowTime
            ShowIter
            OverPlot2
            NewPlot2
            i = i - 1
        Wend
                q% = DoEvents()
        swic = swic + 1
        unit(i + 1) = v
        newx1 = unit(i + 1)
        newy1 = i + 1
        ShowTime
        ShowIter
        OverPlot1
        NewPlot1
    Next j
    ShowTime
    ShowIter
End Sub
Sub NewPlot ()
SortPlot.PSet (newx1, newy1), QBColor(0)
SortPlot.PSet (newx2, newy2), QBColor(0)
'SortPlot.PSet (newx1, newy1), QBColor(11)
'SortPlot.PSet (newx2, newy2), QBColor(11)
End Sub
Sub NewPlot1 ()
SortPlot.PSet (newx1, newy1), QBColor(0)
'SortPlot.PSet (newx1, newy1), QBColor(11)
End Sub
Sub NewPlot2 ()
SortPlot.PSet (newx2, newy2), QBColor(0)
'SortPlot.PSet (newx2, newy2), QBColor(11)
End Sub
Sub OverPlot ()
SortPlot.PSet (oldx1, oldy1), QBColor(15)
SortPlot.PSet (oldx2, oldy2), QBColor(15)
End Sub
Sub OverPlot1 ()
SortPlot.PSet (oldx1, oldy1), QBColor(15)
End Sub
Sub OverPlot2 ()
    SortPlot.PSet (oldx2, oldy2), QBColor(15)
End Sub
Sub qsort ()
    Dim i As Integer, j As Integer, b As Integer, l As Integer, t As Integer, r As Integer, d As Integer
    StartTime = Now
    k = 1
    p(k) = 1
    w(k) = 100
    l = 1
    d = 1
    r = 100
    Do
toploop:
                q% = DoEvents()
        If r - l < 9 Then GoTo bubsort
                q% = DoEvents()
        i = l
        j = r
        While j > i
            comp = comp + 1
                q% = DoEvents()
            If unit(i) > unit(j) Then
                q% = DoEvents()
                swic = swic + 1
                t = unit(j)
                oldx1 = unit(j)
                oldy1 = j
                unit(j) = unit(i)
                oldx2 = unit(i)
                oldy2 = i
                newx1 = unit(j)
                newy1 = j
                unit(i) = t
                newx2 = unit(i)
                newy2 = i
                OverPlot
                NewPlot
                ShowTime
                ShowIter
                d = -d
            End If
            If d = -1 Then
                j = j - 1
                q% = DoEvents()
            Else
                i = i + 1
                q% = DoEvents()
            End If
        Wend
        j = j + 1
        k = k + 1
                q% = DoEvents()
        If i - l < r - j Then
            p(k) = j
            w(k) = r
            r = i
                q% = DoEvents()
        Else
            p(k) = l
            w(k) = i
            l = j
                q% = DoEvents()
        End If
        d = -d
                q% = DoEvents()
        GoTo toploop
bubsort:
        If r - l > 0 Then
                q% = DoEvents()
            For i = l To r
                b = i
                q% = DoEvents()
                For j = b + 1 To r
                    comp = comp + 1
                    If unit(j) <= unit(b) Then b = j
                q% = DoEvents()
                Next j
                If i <> b Then
                q% = DoEvents()
                    swic = swic + 1
                    t = unit(b)
                    oldx1 = unit(b)
                    oldy1 = b
                    unit(b) = unit(i)
                    oldx2 = unit(i)
                    oldy2 = i
                    newx1 = unit(b)
                    newy1 = b
                    unit(i) = t
                    newx2 = unit(i)
                    newy2 = i
                    OverPlot
                    NewPlot
                    ShowTime
                    ShowIter
                End If
            Next i
        End If
        l = p(k)
        r = w(k)
        k = k - 1
                q% = DoEvents()
    Loop Until k = 0
    ShowTime
    ShowIter
End Sub
Sub RackEmUp ()
If first_pass = False Then
    For cell = 1 To 100
MakeCell:
        vl = Int(Rnd(1) * 100) + 1
        'For chk = 1 To cell - 1
            'If vl = unit(chk) Then GoTo MakeCell
        'Next chk
        unit(cell) = vl
        base_data(cell) = vl
    Next cell
    first_pass = True
    For x = 1 To 100
        unit(x) = base_data(x)
    Next x
End If
End Sub
Sub RadixSort_Click ()
If Done = True Then resetplot
rsort
End Sub
Sub resetplot ()
    Screen.MousePointer = 11
    SortPlot.Line (1, 1)-(100, 100), QBColor(0), BF
    SortPlot.Refresh
    comp = 0
    swic = 0
    RackEmUp
    ShowPlots
    Screen.MousePointer = 0
End Sub
Sub rsort ()
End Sub
Sub selsort ()
    Dim i As Integer, j As Integer, t As Integer, n As Integer
    StartTime = Now
    n = 100
    For i = 1 To n - 1
        q% = DoEvents()
        For j = i + 1 To n
        q% = DoEvents()
            comp = comp + 1
            If unit(j) < unit(i) Then
        q% = DoEvents()
                swic = swic + 1
                t = unit(i)
                oldx1 = unit(i)
                oldy1 = i
                unit(i) = unit(j)
                newx1 = unit(i)
                newy1 = i
                oldx2 = unit(j)
                oldy2 = j
                unit(j) = t
                newx2 = unit(j)
                newy2 = j
                ShowTime
                ShowIter
                OverPlot
                NewPlot
            End If
        q% = DoEvents()
        Next j
        q% = DoEvents()
    Next i
    ShowTime
    ShowIter
End Sub
Sub ShowIter ()
    iterations.Caption = LTrim$(Str$(comp))
    iterations.Refresh
    swaps.Caption = LTrim$(Str$(swic))
    swaps.Refresh
End Sub
Sub ShowPlots ()
    For lin = 1 To 100
        SortPlot.PSet (unit(lin), lin), QBColor(0)
    Next lin
End Sub
Sub ShowTime ()
    elapsed# = Now - StartTime
    tim$ = Format$(elapsed#, "hh:mm:ss")
    clock.Caption = tim$
    clock.Refresh
End Sub
Sub ssort ()
    Dim m As Integer, j As Integer, i As Integer, t As Integer
    StartTime = Now
    m = 100
    While m > 0
                q% = DoEvents()
        m = m \ 2
        For i = m To 99
                q% = DoEvents()
            For j = (i - m + 1) To 1 Step -m
                comp = comp + 1
                q% = DoEvents()
                If unit(j) <= unit(j + m) Then Exit For
                q% = DoEvents()
                swic = swic + 1
                t = unit(j)
                oldx1 = unit(j)
                oldy1 = j
                unit(j) = unit(j + m)
                newx1 = unit(j)
                newy1 = j
                oldx2 = unit(j + m)
                oldy2 = j + m
                unit(j + m) = t
                newx2 = unit(j + m)
                newy2 = j + m
                ShowTime
                ShowIter
                OverPlot
                NewPlot
            Next j
        Next i
    Wend
    ShowTime
    ShowIter
End Sub
Sub START_Click ()
text1.Visible = True
start.Enabled = False
exit_pgm.Enabled = True
sorts.Caption = "Bubble Sort"
resetplot
Refresh
bsort
results(0, 1) = "Bubble sort"
results(1, 1) = Str$(time_gone())
results(2, 1) = iterations.Caption
results(3, 1) = swaps.Caption
sorts.Caption = "DF Sort"
resetplot
Refresh
dfsort
results(0, 2) = "DF Sort"
results(1, 2) = Str$(time_gone())
results(2, 2) = iterations.Caption
results(3, 2) = swaps.Caption
sorts.Caption = "GK Sort"
resetplot
Refresh
gksort
results(0, 3) = "GK Sort"
results(1, 3) = Str$(time_gone())
results(2, 3) = iterations.Caption
results(3, 3) = swaps.Caption
sorts.Caption = "Heap Sort"
resetplot
Refresh
hsort
results(0, 4) = "Heap Sort"
results(1, 4) = Str$(time_gone())
results(2, 4) = iterations.Caption
results(3, 4) = swaps.Caption
sorts.Caption = "Insertion Sort"
resetplot
Refresh
isort
results(0, 5) = "Insertion Sort"
results(1, 5) = Str$(time_gone())
results(2, 5) = iterations.Caption
results(3, 5) = swaps.Caption
sorts.Caption = "Quick Sort"
resetplot
Refresh
qsort
results(0, 6) = "Quick Sort"
results(1, 6) = Str$(time_gone())
results(2, 6) = iterations.Caption
results(3, 6) = swaps.Caption
sorts.Caption = "Selective Sort"
resetplot
Refresh
selsort
results(0, 7) = "Selective Sort"
results(1, 7) = Str$(time_gone())
results(2, 7) = iterations.Caption
results(3, 7) = swaps.Caption
sorts.Caption = "Shell Sort"
resetplot
Refresh
ssort
results(0, 8) = "Shell Sort"
results(1, 8) = Str$(time_gone())
results(2, 8) = iterations.Caption
results(3, 8) = swaps.Caption
text1.Visible = False
start.Enabled = True
exit_pgm.Enabled = False
End Sub
Sub SubPlot ()
    SortPlot.PSet (subx, suby), QBColor(13)
End Sub
Function time_gone ()
q$ = clock.Caption
hours = Val(Left$(q$, 2))
minutes = Val(Mid$(q$, 4, 2))
seconds = Val(Right$(q$, 2))
time_gone = seconds + (minutes * 60) + (hours * 360)
End Function
Sub UnSubPlot ()
    SortPlot.PSet (unsubx, unsuby), QBColor(11)
End Sub